Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/forms/frmwiz/fieldfrm.frm

Visual Basic Form | 1995-01-15 | 11.2 KB | 346 lines

VERSION 2.00
Begin Form FieldFrm
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form Wizard - Field Selection"
   ClientHeight    =   5115
   ClientLeft      =   1095
   ClientTop       =   1260
   ClientWidth     =   7845
   ControlBox      =   0   'False
   Height          =   5520
   HelpContextID   =   26
   Icon            =   FIELDFRM.FRX:0000
   Left            =   1035
   LinkTopic       =   "Form2"
   ScaleHeight     =   5115
   ScaleWidth      =   7845
   Top             =   915
   Width           =   7965
   Begin SSCommand BtnHelp
      Caption         =   "&Help"
      Font3D          =   2  'Raised w/heavy shading
      Height          =   615
      Left            =   4860
      Picture         =   FIELDFRM.FRX:0302
      TabIndex        =   11
      Top             =   4020
      Width           =   915
   End
   Begin SSPanel cMsg
      Align           =   2  'Align Bottom
      Alignment       =   1  'Left Justify - MIDDLE
      BevelInner      =   1  'Inset
      BorderWidth     =   2
      Height          =   375
      Left            =   0
      TabIndex        =   10
      Top             =   4740
      Width           =   7845
   End
   Begin SSCommand BtnFinish
      AutoSize        =   2  'Adjust Button Size To Picture
      Caption         =   "&Finish"
      Enabled         =   0   'False
      Font3D          =   2  'Raised w/heavy shading
      Height          =   615
      Left            =   3960
      Picture         =   FIELDFRM.FRX:0604
      TabIndex        =   9
      Top             =   4020
      Width           =   915
   End
   Begin SSCommand BtnCancel
      AutoSize        =   2  'Adjust Button Size To Picture
      Caption         =   "&Cancel"
      Font3D          =   2  'Raised w/heavy shading
      Height          =   615
      Left            =   3060
      Picture         =   FIELDFRM.FRX:0906
      TabIndex        =   6
      Tag             =   "Cancel building the form"
      Top             =   4020
      Width           =   915
   End
   Begin SSCommand BtnNext
      AutoSize        =   2  'Adjust Button Size To Picture
      Caption         =   "&Next"
      Font3D          =   2  'Raised w/heavy shading
      Height          =   615
      Left            =   2160
      Picture         =   FIELDFRM.FRX:0C08
      TabIndex        =   5
      Tag             =   "Proceed to the next step"
      Top             =   4020
      Width           =   915
   End
   Begin SSCommand BtnPrev
      AutoSize        =   2  'Adjust Button Size To Picture
      Caption         =   "&Previous"
      Font3D          =   2  'Raised w/heavy shading
      Height          =   615
      Left            =   1260
      Picture         =   FIELDFRM.FRX:0F0A
      TabIndex        =   4
      Tag             =   "Return to the previous step"
      Top             =   4020
      Width           =   915
   End
   Begin SSFrame FramFldsOnForm
      Alignment       =   2  'Center
      Caption         =   "Fields On Form"
      ForeColor       =   &H00FF0000&
      Height          =   3675
      Left            =   3900
      TabIndex        =   8
      Top             =   240
      Width           =   3795
      Begin Grid GrdFields
         Cols            =   4
         FixedRows       =   0
         Height          =   3315
         Left            =   120
         Rows            =   1
         TabIndex        =   2
         Tag             =   "Select one or more fields, right click to change attributes"
         Top             =   240
         Width           =   3555
      End
   End
   Begin SSFrame Frame3D1
      Alignment       =   2  'Center
      Caption         =   "Select Fields For Form"
      ForeColor       =   &H00FF0000&
      Height          =   3735
      Left            =   120
      TabIndex        =   7
      Top             =   180
      Width           =   2595
      Begin ListBox LstFields
         BackColor       =   &H00C0C0C0&
         Height          =   3345
         Left            =   120
         MultiSelect     =   2  'Extended
         TabIndex        =   0
         Tag             =   "Select one or more fields to add to the form"
         Top             =   300
         Width           =   2355
      End
   End
   Begin SSCommand BtnRemove
      AutoSize        =   2  'Adjust Button Size To Picture
      Caption         =   "&Remove"
      Font3D          =   2  'Raised w/heavy shading
      Height          =   555
      Left            =   2820
      Picture         =   FIELDFRM.FRX:120C
      TabIndex        =   3
      Tag             =   "Remove selected field(s) from the form"
      Top             =   1200
      Width           =   975
   End
   Begin SSCommand BtnAdd
      AutoSize        =   2  'Adjust Button Size To Picture
      Caption         =   "&Add"
      Font3D          =   2  'Raised w/heavy shading
      Height          =   555
      Left            =   2820
      Picture         =   FIELDFRM.FRX:150E
      TabIndex        =   1
      Tag             =   "Add selected field(s) to the form"
      Top             =   600
      Width           =   975
   End
Option Explicit
Dim maxwidth(3) As Long
Sub BtnAdd_Click ()
    Dim i As Integer, fld As String
    ' Add selected feilds to grid
    For i = 0 To LstFields.ListCount - 1
        If LstFields.Selected(i) Then
            fld = LstFields.List(i)
            GrdFields.AddItem fld & Chr$(9) & fld & Chr$(9) & "No" & Chr$(9) & Str$(aiFldSize(i))
            If TextWidth(fld) + 150 > maxwidth(0) Then
                maxwidth(0) = TextWidth(fld) + 150
                GrdFields.ColWidth(0) = maxwidth(0)
            End If
            If TextWidth(fld) + 150 > maxwidth(1) Then
                maxwidth(1) = TextWidth(fld) + 150
                GrdFields.ColWidth(1) = maxwidth(1)
            End If
        End If
    Next i
    If GrdFields.Rows > 1 Then GrdFields.FixedRows = 1
End Sub
Sub BtnAdd_GotFocus ()
    cMsg.Caption = BtnAdd.Tag
End Sub
Sub BtnCancel_Click ()
    EndItNow
End Sub
Sub BtnCancel_GotFocus ()
    cMsg.Caption = BtnCancel.Tag
End Sub
Sub BtnHelp_Click ()
    SendKeys "{F1}"
End Sub
Sub BtnNext_Click ()
    Dim contanyway As Integer
    Dim msg As String
    If GrdFields.Rows = 1 Then
        Beep
        msg = "You haven't specified any fields for the form!  Do you want to continue anyway?"
        contanyway = MsgBox(msg, MB_ICONQUESTION + MB_YESNO, "Field Selection")
        If contanyway = IDNO Then
            Exit Sub
        End If
    End If
    GenForm.Show MODELESS
    FieldFrm.Hide
End Sub
Sub BtnNext_GotFocus ()
    cMsg.Caption = BtnNext.Tag
End Sub
Sub BtnPrev_Click ()
    DataSpec.Show MODELESS
    FieldFrm.Hide
End Sub
Sub BtnPrev_GotFocus ()
    cMsg.Caption = BtnPrev.Tag
End Sub
Sub BtnRemove_Click ()
    On Error GoTo removeerr
    Dim i As Integer, i2 As Integer
    ' Remove any selected rows except the last one
    For i = GrdFields.Rows - 2 To 0 Step -1
        GrdFields.Row = i
        GrdFields.Col = 1
        If GrdFields.CellSelected Then
            GrdFields.RemoveItem i
        End If
    Next i
    ' Check if last row is deleted and handle special to prevent error
    ' caused by selection defaulting to the entire table when the last
    ' row is removed
    i = GrdFields.Rows - 1
    GrdFields.Row = i
    GrdFields.Col = 1
    If GrdFields.CellSelected Then
        GrdFields.FixedRows = 0
        GrdFields.RemoveItem i
    End If
    GrdFields.Refresh
    If GrdFields.Rows > 1 Then GrdFields.FixedRows = 1
    Exit Sub
removeerr:
    erraction = RB_ErrorHandler("FieldFrm", "BtnRemove_Click")
    Select Case erraction
    Case 1
        Resume 0      ' Retry option selected
    Case 2
        Resume Next   ' Ignore option selected
    End Select
End Sub
Sub BtnRemove_GotFocus ()
    cMsg.Caption = BtnRemove.Tag
End Sub
Sub Form_Activate ()
    Dim ds As dynaset, ssfields As snapshot
    Dim iNumFlds As Integer
    On Error GoTo formacterr
    ' Load list of fields in record source
    If NewRecordSource Then
        Set ds = db.CreateDynaset(DataSpec.LstRecSrce.Text)
        Set ssfields = ds.ListFields()
        ds.Close
        LstFields.Clear
        ReDim aiFldSize(1)
        iNumFlds = -1
        Do While Not ssfields.EOF
            LstFields.AddItem ssfields!Name
            iNumFlds = iNumFlds + 1
            ReDim Preserve aiFldSize(iNumFlds)
            aiFldSize(iNumFlds) = ssfields!Size
            ssfields.MoveNext
        Loop
        ssfields.Close
        NewRecordSource = False
        ' Clear the grid of fields
        GrdFields.Rows = 1
    End If
    Exit Sub
formacterr:
    erraction = RB_ErrorHandler("FieldFrm", "Form_Activate")
    Select Case erraction
    Case 1
        Resume 0      ' Retry option selected
    Case 2
        Resume Next   ' Ignore option selected
    End Select
End Sub
Sub Form_Load ()
    On Error GoTo loaderr
    ' Set up grid headings
    GrdFields.Row = 0
    GrdFields.Col = 0
    GrdFields.Text = "Field"
    GrdFields.ColWidth(0) = TextWidth(" Field ")
    maxwidth(0) = GrdFields.ColWidth(0)
    GrdFields.Col = 1
    GrdFields.Text = "Label"
    GrdFields.ColWidth(1) = TextWidth(" Label ")
    maxwidth(1) = GrdFields.ColWidth(1)
    GrdFields.Col = 2
    GrdFields.Text = "Same" & Chr$(13) & "Line"
    GrdFields.ColWidth(2) = TextWidth(" Same ")
    maxwidth(2) = GrdFields.ColWidth(2)
    GrdFields.Col = 3
    GrdFields.Text = "Size"
    GrdFields.ColWidth(3) = TextWidth(" Size ")
    GrdFields.RowHeight(0) = 2 * TextHeight("Same")
    Exit Sub
loaderr:
    erraction = RB_ErrorHandler("FieldFrm", "Form_Load")
    Select Case erraction
    Case 1
        Resume 0      ' Retry option selected
    Case 2
        Resume Next   ' Ignore option selected
    End Select
End Sub
Sub Form_Resize ()
    If FieldFrm.WindowState <> 1 Then
        FramFldsOnForm.Width = FieldFrm.Width - FramFldsOnForm.Left - 250
        GrdFields.Width = FramFldsOnForm.Width - GrdFields.Left - 150
    End If
End Sub
Sub GrdFields_GotFocus ()
    cMsg.Caption = GrdFields.Tag
End Sub
Sub GrdFields_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer, istart As Integer, iend As Integer
    If Button = RIGHT_BUTTON Then
        istart = GrdFields.SelStartRow
        If istart = 0 Then istart = 1
        iend = GrdFields.SelEndRow
        For i = istart To iend
            GrdFields.Row = i
            GrdFields.Col = 0
            ChngFld.LblField.Caption = GrdFields.Text
            GrdFields.Col = 1
            ChngFld.TxtLabel = GrdFields.Text
            GrdFields.Col = 2
            If GrdFields.Text = "Yes" Then
                ChngFld.ChkSameLine.Value = True
            Else
                ChngFld.ChkSameLine.Value = False
            End If
            ChngFld.LblRow.Caption = Str$(i)
            ChngFld.Show MODAL
        Next i
    End If
End Sub
Sub LstFields_GotFocus ()
    cMsg.Caption = LstFields.Tag
End Sub